home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / PathList < prev    next >
Text File  |  1993-05-06  |  5KB  |  155 lines
  1. \  7/04/86  cdn A general class to maintain lists of paths
  2. \  7/09/86  cdn Added getPtxt
  3. \  9/26/86  rfd added GET:
  4. \ 12/29/90    rfl    now part of sarray
  5. \  1/02/90    rfl    added check for >255 in (count)
  6. \  4/10/91    rfl    fixed to: with @sarray change to return offset
  7.  
  8. \ Class Sarray - string array
  9. \        used just like an array, but with arbitrary length elements.
  10. \        Each element is a pascal string.
  11. \ 11.26.90    rfl    cleared size with new:  
  12. \ 11.28.90    rfl fixed at: sarray by get: size 1-
  13. hex
  14. \ limits checked at high level
  15. create @Sarray    ( ind startAddr -- addr len offset )
  16.     4281 w,                \        clr.l    d1
  17.     205F w,                \        movea.l    (sp)+,a0    \ get start addr
  18.     2248 w,                \        movea.l    a0,a1        \ make a copy
  19.     201F w,                \        move.l    (sp)+,d0    \ get index
  20.     D1CB w,                \        adda.l    a3,a0        \ convert to abs addr
  21.     1218 w,                \ loop    move.b    (a0)+,d1    \ get len
  22.     5380 w,                \        subq.l    #1,d0        \ dec index
  23.     0C80 w,    ffffffff ,    \        cmpi.l    #-1,d0        \ time to get out
  24.     6700 w,    0008 w,        \        beq        out
  25.     D1C1 w,                \        adda.l    d1,a0        \ go to next index
  26.     6000 w,    ffee w,        \        bra loop
  27.     91CB w,                \ out    suba.l    a3,a0        \ get rel addr
  28.     2F08 w,                \        move.l    a0,-(sp)
  29.     2F01 w,                \        move.l    d1,-(sp)
  30.     91c9 w,                \        suba.l    a1,a0        \ get offset from start
  31.     5388 w,                \        subq    #1,a0        \ less one
  32.     2f08 w,                \        move.l    a0,-(sp)
  33. next,
  34.  
  35. \ counts the number of items in an sarray format
  36. create SCount    ( addr len -- n)
  37.     4281 w,                \        clr.l    d1
  38.     241F w,                \        move.l    (sp)+,d2
  39.     2057 w,                \        movea.l    (sp),a0
  40.     D1CB w,                \        adda.l    a3,a0
  41.     2248 w,                \        movea.l    a0,a1
  42.     D3C2 w,                \        adda.l    d2,a1        \ stop addr
  43.     1010 w,                \ loop    move.b    (a0),d0
  44.     D1C0 w,                \        adda.l    d0,a0
  45.     5288 w,                \        addq    #1,a0
  46.     5281 w,                \        addq    #1,d1        \ inc counter
  47.     B3C8 w,                \        cmp.l    a0,a1        \ time to stop
  48.     6E00 w,    fff4 w,        \        bgt        loop
  49.     2E81 w,                \        move.l    d1,(sp)
  50. next,
  51.  
  52. \ If the list is a list of items separated by a delimeter, then this word
  53. \  searches through list, finds delimeters and replaces with the count to
  54. \  bring it to sarray format. Proceeds to end of string with or without a delimeter there
  55. create (count)            \ ( addr len delimeter -- count)
  56.     4282 w,                \        clr.l    d2            \ count
  57.     261F w,                \        move.l    (sp)+,d3    \ char
  58.     2C1F w,                \        move.l    (sp)+,d6    \ len
  59.     2057 w,                \        movea.l    (sp),a0        \ addr
  60.     D1CB w,                \        adda.l    a3,a0
  61.     5288 w,                \        addq    #1,a0
  62.     2248 w,                \        movea.l    a0,a1        \ store start
  63.     B618 w,                \ start    cmp.b    (a0)+,d3    \ compare first char with delimeter
  64.     6600 w, 0022 w,        \        bne        noadd        \ if no match, continue
  65.     5282 w,                \        addq    #1,d2        \ else, increment count
  66.     2008 w,                \        move.l    a0,d0
  67.     9089 w,                \        sub.l    a1,d0
  68.     5380 w,                \        subq    #1,d0
  69.     b07c w, 00ff w,        \        cpi.w    #255,d0        \ make sure element is <255
  70.     6d00 w, 000c w,        \        blt        ok
  71.     2ebc w, ffffffff ,    \        move.l    #-1,(sp)    \ put -1 on stack if illegal
  72.     6000 w, 0010 w,        \        bra        out
  73.     1340 w,    ffff w,        \        move.b    d0,-1(a1)    \ get size and put into location
  74.     2248 w,                \        movea.l    a0,a1        \ get new size location
  75.     5386 w,                \ noadd    subq.l    #1,d6        \ one less to go
  76.     6E00 w,    ffd6 w,        \        bgt        start        \ continue until zero
  77.     2E82 w,                \        move.l    d2,(sp)        \ store count on stack
  78.                         \ out    
  79. next,
  80.  
  81. decimal
  82.  
  83. \ class of ordered-col of strings. format is str255str255.....str255
  84. :CLASS sarray <super string
  85.  
  86.   var    size        \ # of elements in array
  87.   int    delimeter
  88.  
  89. \ clearing size prevents problems when image is saved with size set nonzero
  90.   :M new: new: super clear: size ;M
  91.  
  92. \ returns # of elements
  93.   :M limit: ( -- n) get: size ;M
  94.  
  95.   :M putLimit: ( n --) put: size ;M
  96.  
  97.   :M putChar: ( n --) put: delimeter ;M
  98.  
  99. \ if want to go faster, remove range checking
  100.   :M at: ( ind -- addr len) dup get: size 1- > >r dup 0< r> or classerr" 129 ptr: self @sarray
  101.         put: offset ;M
  102.  
  103.   :M ^elem: ( ind -- addr) at: self drop 1- ;M
  104.  
  105.   :M print: limit: self 0 DO i . i at: self type cr ?pause LOOP ;M
  106.  
  107.   :M indexOf: { addr len \ flag -- ind t or f }
  108.     limit: self 0 false -> flag
  109.     DO addr len i at: self s= IF i true -> flag LEAVE THEN LOOP
  110.     flag ;M
  111.  
  112.   :M remove: ( ind -- )
  113.     ^elem: self dup ptr: self - put: offset
  114.     dup c@ 1+ delete: super -1 +: size ;M
  115.  
  116.   :M to: { addr len ind -- } ind at: self
  117.     swap 1- swap 1+ addr len str255 -base len 1+ replace: self ;M
  118.  
  119.   :M add: { addr len -- } len 255 > classerr" 135
  120.     len +: super addr len add: super 1 +: size ;M
  121.  
  122.   :M clear: clear: super clear: size ;M
  123.  
  124.   :M =: { anotherSarray -- } getState: super lock: self
  125.         get: self put: anotherSarray setState: self
  126.         limit: self putLimit: anotherSarray ;M
  127.  
  128. \ given the addr len of an sarray format list on the stack, put into an object
  129.   :M put: ( addr len --) put: super get: self scount put: size ;M
  130.  
  131. \ use for delimeted string, thus far uncounted. If already in format, don't use
  132.   :M count: get: self + 1- c@ get: delimeter <>
  133.         IF get: delimeter +: self THEN
  134.         start: self pad 1 insert: self
  135.         get: self get: delimeter (count) put: size
  136.         size: self 1- setsize: self get: size 0< classerr" 135 ;M
  137.  
  138. \ use instead of put:
  139. \ assuming the data is delimited by some character, as in the following format:
  140. \ dddd|dd|dddd|dddd|
  141. \ where d is data and | is the delimeter - last element doesn't need trailing delimeter
  142. \ modify to the sarray format.
  143.   :M place: ( addr len --) put: super count: self ;M
  144.  
  145. ;CLASS
  146.  
  147. \ ( addr len -- )  Setup path string from text file
  148. : getPtxt     new: loadFile  name: topFile
  149.     OpenReadOnly: topFile ?error 179
  150.     path IF release: path dispose> path THEN
  151.     heap> sarray -> path new: path 13 putChar: path
  152.     topfile size: topfile read: path drop
  153.     count: path
  154.     remove: loadFile ;
  155.